home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 175 / 175.d81 / b.fox & hounds 2 (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  7KB  |  224 lines
  1. 10 poke56,56:clr:dv=peek(186):ifdv<8ordv>29thendv=8
  2. 12 poke53371,0
  3. 20 sys57812"font2",dv,0:poke780,0:poke781,0:poke782,56:sys65493:poke53272,31
  4. 30 dv=peek(186):ifdv<8ordv>29thendv=8
  5. 40 sys57812"wh",dv,0:poke780,0:poke781,0:poke782,192:sys65493
  6. 50 gosub80:rem instructions  fox and hounds  floyd r kirk
  7. 60 gosub1910:rem choice
  8. 70 goto400
  9. 80 deffnt(x)=2^(x-1):b1$="                                       "
  10. 90 b$="    [157][157][157][157]    ":r$="[177][187][167][170][157][157][157][157][175][178][174][163][144]":w$="[184][190][179][189][157][157][157][157][173][255]& [144]"
  11. 100 poke53280,15:poke53281,15:poke646,0:print""
  12. 110 gosub3000
  13. 120 print"  [194]e either the fox or the hounds and"
  14. 130 print"play the computer, or play both sides."
  15. 140 print"[212]he sides alternate one move at a time"
  16. 150 print"to a connecting empty square. [212]he three"
  17. 160 print"white hounds win if they block the one"
  18. 170 print"red fox in the rightmost square by their";
  19. 180 print"20th move. [212]he fox wins all the rest,"
  20. 190 print"such as by reaching the leftmost square"
  21. 200 print"or even if trapped on the wrong square."
  22. 210 print"  [212]he fox can move to any empty"
  23. 220 print"connecting square. [193] hound can move up,"
  24. 230 print"down, right, right-and-up, and"
  25. 240 print"right-and-down, but never to the left.":print
  26. 250 printtab(7);"[144]@[161]@[161]@        [182][181]     [162][182][181]"
  27. 260 printtab(6);"[181][182][162][182][181][182][162]       @[161]     [161]@[161]"
  28. 270 printtab(5);"@[161]@[161]@[161]@[161]@      [182][162]     [181][182][162]"
  29. 280 printtab(6);"[162][182][181][182][162][182][181]"
  30. 290 printtab(7);"@[161]@[161]@        [200]ound  [198]ox"
  31. 300 printtab(5);"[212]he [194]oard      [205]oves  [205]oves":poke198,0
  32. 310 diml%(11,11),s%(165),r%(30,2),a%(165,11),w%(3)
  33. 320 i=1:forl=1to9:l1=fnt(l):form=l+1to10:m1=fnt(m)
  34. 330 forr=m+1to11:s%(i)=l1+m1+fnt(r):i=i+1:nextr,m,l
  35. 340 fori=1to30:forj=1to2:r%(i,j)=0:nextj,i
  36. 350 fori=1to11:forj=1to11:readl%(i,j):nextj,i
  37. 360 print"               [208]ress a key"
  38. 370 getz$:ifz$=""then370
  39. 380 return
  40. 390 rem new game begins here
  41. 400 w%(1)=1:w%(2)=2:w%(3)=4:i0=1
  42. 410 b=int(rnd(0)*9)+3:ifb=4then410
  43. 420 gosub1470
  44. 430 rem main program loop
  45. 440 r=18:c=6:gosub1900:printi0
  46. 450 ifn=2thengosub1180:v=peek(49152+11*(s3-1)+b):x=(vand240)/16:y=vand15:goto740
  47. 460 f$="[133]":w%(0)=b:fori=1to3:ifw%(i)=11then520
  48. 470 forj=2to11:ifl%(w%(i),j)<>2then510
  49. 480 fork=0to3:ifw%(k)=jthenk=5
  50. 490 nextk:ifk>5then510
  51. 500 f$=f$+chr$(w%(i)+64):j=11
  52. 510 nextj
  53. 520 nexti
  54. 530 iff$="[133]"then1050
  55. 540 r=18:c=31:gosub1900:print"f1[144] [209]uit."
  56. 550 j=1:r=21:c=0:gosub1900:print"[200]ound moves from":poke 198,0
  57. 560 geta$:ifa$=""then560
  58. 570 ifa$>="[193]"thena$=chr$(asc(a$)-128)
  59. 580 fori=1tolen(f$):ifa$=mid$(f$,i,1)thenj=i+1:r=18:c=31:gosub1900:print"        "
  60. 590 next:onjgoto560,1050,600,600,600
  61. 600 x=asc(a$)-64
  62. 610 r=21:c=17:gosub1900:printchr$(x+192);";"
  63. 620 f$="":forj=2to11:ifl%(x,j)<>2then660
  64. 630 fork=0to3:ifw%(k)=jthenk=5
  65. 640 nextk:ifk>5then660
  66. 650 f$=f$+chr$(j+64)
  67. 660 nextj
  68. 670 j=1:r=21:c=20:gosub1900:print"moves to ";:poke198,0
  69. 680 geta$:ifa$=""then680
  70. 690 ifa$>="[193]"thena$=chr$(asc(a$)-128)
  71. 700 fori=1tolen(f$):ifa$=mid$(f$,i,1)thenj=i+1
  72. 710 next:ifj=1then680
  73. 720 y=asc(a$)-64
  74. 730 r=21:c=0:gosub1900:printb1$
  75. 740 i=1
  76. 750 ifw%(i)=xthenw%(i)=y:goto770
  77. 760 i=i+1:ifi<4then750
  78. 770 z=x:gosub1780:printb$:z=y:gosub1780:printw$
  79. 780 gosub1180: rem legal move; what is white position index (s3)
  80. 790 ifn=1then970
  81. 800 f$="[133]":forj=1to11:ifl%(b,j)=0then840
  82. 810 fork=1to3:ifw%(k)=jthenk=5
  83. 820 next:ifk>5then840
  84. 830 f$=f$+chr$(j+64)
  85. 840 nextj
  86. 850 iff$="[133]"andb<>11then1050
  87. 860 iff$="[133]"then1060
  88. 870 r=18:c=31:gosub1900:print"f1[144] [209]uit."
  89. 880 r=21:c=0:gosub1900:print"[198]ox moves to":j=1:poke198,0
  90. 890 geta$:ifa$=""then890
  91. 900 ifa$>="[193]"thena$=chr$(asc(a$)-128)
  92. 910 fori=1tolen(f$):ifa$=mid$(f$,i,1)thenj=i+1:r=18:c=31:gosub1900:print"        "
  93. 920 next:ifj=1then890
  94. 930 ifj=2then1060
  95. 940 r=21:c=0:gosub1900:printb1$
  96. 950 m4=asc(mid$(f$,j-1,1))-64:goto1010
  97. 960 rem what is reds best move, if any
  98. 970 gosub1230:ifm4=0andb=11then1060
  99. 980 ifm4=0then1050
  100. 990 rem red moves to m4
  101. 1000 r%(i0,1)=s3:r%(i0,2)=m4
  102. 1010 z=b:gosub1780:printb$:b=m4:z=b:gosub1780:printr$
  103. 1020 i0=i0+1:ifi0>20then1050
  104. 1030 ifb>1then440
  105. 1040 rem game ends
  106. 1050 r=21:c=0:gosub1900:print" [198]ox wins.";:w=1:goto1070
  107. 1060 r=21:c=0:gosub1900:print" [200]ounds win.";:w=-1:i=0
  108. 1070 ifn=1thenfori6=1toi0-1:s=r%(i6,1):m=r%(i6,2):a%(s,m)=a%(s,m)+w:next:rem fox learn
  109. 1080 print"  [215]ant to play again? (y[144]/n[144])":poke198,0
  110. 1090 getz$:ifz$<>""then1140
  111. 1100 ifw=-1then1120
  112. 1110 z=b:gosub1780:printb$:poke53280,2:gosub1780:printr$:poke53280,15:goto1090
  113. 1120 i=i+1:ifi>3theni=1
  114. 1130 z=w%(i):gosub1780:printb$:poke53280,1:gosub1780:printw$:poke53280,15:goto1090
  115. 1140 ifz$="y"orz$="[217]"then60
  116. 1150 ifz$<>"n"andz$<>"[206]"then1090
  117. 1160 goto40000
  118. 1170 rem calc new white position number
  119. 1180 a3=fnt(w%(1))+fnt(w%(2))+fnt(w%(3)):s3=1
  120. 1190 ifs%(s3)=a3then1210
  121. 1200 s3=s3+1:ifs3<166then1190
  122. 1210 return
  123. 1220 rem pick reds best move
  124. 1230 m4=0:fori4=1to11:ifl%(b,i4)=0then1310
  125. 1240 rem neighbor square found. white occupied?
  126. 1250 j4=1
  127. 1260 ifw%(j4)=i4then1310
  128. 1270 j4=j4+1:ifj4<4then1260
  129. 1280 ifm4=0then1300
  130. 1290 ifa%(s3,m4)>=a%(s3,i4)then1310
  131. 1300 m4=i4
  132. 1310 next:return:rem reds best move
  133. 1320 rem data for l%(i,j) array
  134. 1330 rem l%(i,j)=0 means i to j not legal
  135. 1340 rem l%(i,j)=1 means i to j legal fox only
  136. 1350 rem l%(i,j)=2 means i to j legal both hound and fox
  137. 1360 data0,2,2,2,0,0,0,0,0,0,0
  138. 1370 data1,0,2,0,2,2,0,0,0,0,0
  139. 1380 data1,2,0,2,0,2,0,0,0,0,0
  140. 1390 data1,0,2,0,0,2,2,0,0,0,0
  141. 1400 data0,1,0,0,0,2,0,2,0,0,0
  142. 1410 data0,1,1,1,2,0,2,2,2,2,0
  143. 1420 data0,0,0,1,0,2,0,0,0,2,0
  144. 1430 data0,0,0,0,1,1,0,0,2,0,2
  145. 1440 data0,0,0,0,0,1,0,2,0,2,2
  146. 1450 data0,0,0,0,0,1,1,0,2,0,2
  147. 1460 data0,0,0,0,0,0,0,1,1,1,0
  148. 1470 print"[147]";tab(12);"[198][207][216] [193][206][196] [200][207][213][206][196][211]"
  149. 1480 printtab(11);"[185][185][185][185]   [185][185][185][185]   [185][185][185][185]"
  150. 1490 printtab(10);"[172]    [191] [172]    [191] [172]    [191]"
  151. 1500 printtab(10);"[172]  [194] [165][185][188]  [197] [165][185][188]  [200] [191]"
  152. 1510 printtab(10);"[172]    [191] [172]    [191] [172]    [191]"
  153. 1520 printtab(10);"[172]    [191] [172]    [191] [172]    [191]"
  154. 1530 printtab(10);"[181][176][180][176][176][162]  [176][180][176][176]  [181][176][180][176][176][162]"
  155. 1540 printtab(9);"[181]  [172]   [162]  [172]   [181]  [172]   [162]"
  156. 1550 printtab(4);"[185][185][185][185][181]  [185][188][185][185]  [162][185][188][185][185][181]  [185][188][185][185]  [162][185][185][185][185]"
  157. 1560 print"   [172][197][216][201][212][144][191] [172]    [191] [172]    [191] [172]    [191] [172] [196][197][206][144][191]"
  158. 1570 print"   [172]  [193] [165][185][188]  [195] [165][185][188]  [198] [165][185][188]  [201] [165][185][188]  [203] [191]"
  159. 1580 print"   [172]    [191] [172]    [191] [172]    [191] [172]    [191] [172]    [191]"
  160. 1590 print"   [172]    [191] [172]    [191] [172]    [191] [172]    [191] [172]    [191]"
  161. 1600 printtab(4);"[176][176][176][176][162]  [176][180][176][176]  [181][176][180][176][176][162]  [176][180][176][176]  [181][176][176][176][176]"
  162. 1610 printtab(9);"[162]  [172]   [181]  [172]   [162]  [172]   [181]"
  163. 1620 printtab(10);"[162][185][188][185][185][181]  [185][188][185][185]  [162][185][188][185][185][181]"
  164. 1630 printtab(10);"[172]    [191] [172]    [191] [172]    [191]"
  165. 1640 printtab(10);"[172]  [196] [165][185][188]  [199] [165][185][188]  [202] [191]"
  166. 1650 print"  [205]ove";i0;tab(10);"[172]    [191] [172]    [191] [172]    [191]"
  167. 1660 printtab(10);"[172]    [191] [172]    [191] [172]    [191]"
  168. 1670 printtab(10);" [176][176][176][176]   [176][176][176][176]   [176][176][176][176]"
  169. 1680 fori=1to3:z=w%(i):gosub1780:printw$:next
  170. 1690 ifn=1then1760
  171. 1700 r=21:c=0:gosub1900:print"[208]lace fox on empty square.":j=1:poke198,0
  172. 1710 geta$:ifa$=""then1710
  173. 1720 f$="cefghijk":ifa$>"[193]"thena$=chr$(asc(a$)-128)
  174. 1730 fori=1to8:ifa$=mid$(f$,i,1)thenj=i+1:r=21:c=0:gosub1900:printb1$
  175. 1740 next:ifj=1goto1710
  176. 1750 b=asc(a$)-64
  177. 1760 z=b:gosub1780:printr$
  178. 1770 return
  179. 1780 onzgoto1790,1800,1810,1820,1830,1840,1850,1860,1870,1880,189